(***************************************************************************************
  												 						CODE GENERATOR
***************************************************************************************)
use "semantic.sml" ;
use "unparse.sml" ;
use "FileStrings.sml";

signature CODE_GEN =
	sig
	val cg : Expr -> string;
	val compileSchemeFile : string * string -> unit;
end;

fun	concatenate _ []  = ""
|	concatenate format (s :: rest) = format(s) ^ concatenate format rest ;

fun makeCString(s) = "\"" ^ String.toCString(s) ^ "\"";

exception unsupportedYET;
structure CodeGen : CODE_GEN =
struct

	(*** CONSTANT ***)

	type CodeConstant = string ;

	fun	generateCodeConstant(c) = c ;

	(*** LABEL ***)

	type Label = string ;

	fun generateCodeLabel(l) = l ;
	fun generateCodeAddressOfLabel(l) = "&&" ^ generateCodeLabel(l) ;

	(*** REGISTER ***)

	datatype Register	= Sp | Fp | ResultReg | ReturnReg | Reg of int ;

	fun	regToString(Sp) = "sp"
	|	regToString(Fp) = "fp"
	|	regToString(ResultReg) = "reg[RES]"
	|	regToString(ReturnReg) = "reg[RET]"
	|	regToString(Reg(i)) = "reg[" ^ Int.toString(i) ^ "]" ;


	fun generateCodeRegister(reg) = "machine." ^ regToString(reg) ;

	(*** INSTRUCTION ***)

	datatype MachineValue	= MachineRegister of Register | MachineLabel of Label | MachineConstant of CodeConstant ;

	fun	generateCodeMachineValue(MachineRegister r) = generateCodeRegister(r)
	|	generateCodeMachineValue(MachineLabel l) = generateCodeLabel(l)
	|	generateCodeMachineValue(MachineConstant c) = generateCodeConstant(c) ;

	datatype Instruction	= Assign of Register * MachineValue
							| Jump of Label
							| CondJump of MachineValue * bool * Label
							| CondEqJump of MachineValue * MachineValue * bool * Label
							| Push of MachineValue
							| Pop of Register
							| BackupReg of Register
							| RestoreReg of Register
							| CallFunc of MachineValue * int * MachineValue * Label
							| CallFuncReg of MachineValue * int * MachineValue * Register
							| Return
							| CallCProc of string * MachineValue list
							| CallCFunc of Register * string * MachineValue list
							| CallCGetter of Register * string * MachineValue (* c func with only one arg *)
							| LabelOnly of Label
							| Comment of string
							| InstructionWithComment of Instruction * string
							| AssignMinus of Register * MachineValue
							| AssignPlus of Register * MachineValue
							| AssignTimes of Register * MachineValue
							| AssignFree of string * string
							| Free of string
							| TraceResult ;


	(* converts mahcine value list to comma separated string *)
	fun	generateArgList([]) = ""
	|	generateArgList([value]) = generateCodeMachineValue(value)
	|	generateArgList(value :: rest) = generateCodeMachineValue(value) ^ ", " ^ generateArgList(rest) ;

	fun generateAssign (target, source,chr) = generateCodeRegister(target) ^ " " ^ chr ^ "= " ^ generateCodeMachineValue(source) ^ " ;" ;

	fun generateCodeInstruction(Assign(target, source)) = generateAssign (target, source,"")

	|   generateCodeInstruction(AssignMinus(target, source)) = generateAssign (target, source,"-")
	|   generateCodeInstruction(AssignPlus(target, source)) = generateAssign (target, source,"+")
	|   generateCodeInstruction(AssignTimes(target, source)) = generateAssign (target, source,"*")

	| generateCodeInstruction(AssignFree(target, source)) = target ^ " = " ^ source ^ " ;"

	|	generateCodeInstruction(Jump l) = "goto " ^ generateCodeLabel(l) ^ " ;"

		(* jump if false, fallthrough if true, suitable for if's and loops *)
	|	generateCodeInstruction(CondJump (test, false, l)) = "if (sobIsFalse(" ^ generateCodeMachineValue(test) ^
			")) " ^ generateCodeInstruction(Jump l)

		(* fallthrough if false, jump if true (well, more like 'jump if not false') *)
	|	generateCodeInstruction(CondJump (test, true, l)) = "if (sobIsntFalse(" ^ generateCodeMachineValue(test) ^
			")) " ^ generateCodeInstruction(Jump l)

		(* equality condition *)
	|	generateCodeInstruction(CondEqJump (test1, test2,true, l)) = "if ("^ generateCodeMachineValue(test1) ^ " == " ^
																	generateCodeMachineValue(test2) ^
																") " ^ generateCodeInstruction(Jump l)
	|	generateCodeInstruction(CondEqJump (test1, test2,false, l)) = "if ("^ generateCodeMachineValue(test1) ^ " != " ^
																	generateCodeMachineValue(test2) ^
																") " ^ generateCodeInstruction(Jump l)
	|	generateCodeInstruction(Push value) = "push((void*)" ^ generateCodeMachineValue(value) ^ ") ;"

	|	generateCodeInstruction(Pop reg) = generateCodeRegister(reg) ^ " = pop() ;"

	|	generateCodeInstruction(BackupReg r) = generateCodeInstruction(Push (MachineRegister r))
	|	generateCodeInstruction(RestoreReg r) = generateCodeInstruction(Pop r)

		(* calling with a label is a simple goto. calling with a value requires 'goto *' *)
	|	generateCodeInstruction(CallFunc (MachineLabel f, argc, env, returnAddress)) =
			generateCodeInstruction(CallCProc ("CALL", [MachineLabel f, MachineConstant (Int.toString(argc)), env,
			MachineConstant (generateCodeAddressOfLabel(returnAddress))]))
	|	generateCodeInstruction(CallFunc (f, argc, env, returnAddress)) =
			generateCodeInstruction (CallCProc("CALL", [MachineConstant ("*" ^ (generateCodeMachineValue(f))),
			MachineConstant (Int.toString(argc)), env, MachineConstant (generateCodeAddressOfLabel returnAddress)]))
	|	generateCodeInstruction(CallFuncReg (f, argc, env, returnAddressAsReg)) =
			generateCodeInstruction (CallCProc("CALL", [MachineConstant ("*" ^ (generateCodeMachineValue(f))),
			MachineConstant (Int.toString(argc)), env, MachineConstant (generateCodeRegister returnAddressAsReg)]))

	|	generateCodeInstruction(Return) = "RETURN() ;"
	|	generateCodeInstruction(CallCProc (name, args)) = name ^ "(" ^ generateArgList(args) ^ ") ;"
	|	generateCodeInstruction(CallCFunc (reg, name, args)) = generateCodeRegister(reg) ^ " = " ^ generateCodeInstruction(CallCProc (name, args))
	|	generateCodeInstruction(CallCGetter (reg, name, arg)) = generateCodeInstruction(CallCFunc (reg, name, [arg]))
	|	generateCodeInstruction(LabelOnly l) = generateCodeLabel(l) ^ ":"
	|	generateCodeInstruction(Comment text) = "/* " ^ text ^ " */"
	|	generateCodeInstruction(InstructionWithComment (inst, comment)) = generateCodeInstruction(inst) ^ " " ^ generateCodeInstruction(Comment comment)
	|	generateCodeInstruction(Free(code)) = code
	|	generateCodeInstruction(TraceResult) = generateCodeInstruction(CallCProc("DEBUG_CASUAL", [MachineConstant (makeCString("result = %p -- %s")), MachineConstant (generateCodeRegister(ResultReg)), MachineConstant ("sobToString(Sob(" ^ generateCodeRegister ResultReg ^ "))")]))

	fun AssertInstruction(time, condition) = CallCProc(time ^ "_ASSERT", [MachineConstant condition]) ;

	fun formatInstruction(instruction) = "\t" ^ instruction ^ "\n" ;
	fun	makeInstructionSequence(instructions) = concatenate (formatInstruction o generateCodeInstruction) instructions ;
	fun makeOneInstruction(instruction) = makeInstructionSequence([instruction]) ;

	fun makeConstructComment(comment, construct) = makeOneInstruction(CallCProc ("DEBUG_TRACE", [MachineConstant (makeCString(comment ^ ": " ^ construct))])) ;

	fun generateDebug (debugType, format, args) =
			makeOneInstruction(CallCProc("DEBUG_" ^ debugType, MachineConstant (makeCString(format)) :: map (fn(x) => MachineConstant (x)) args)) ;

(********************** INIT **********************)
	fun SetlabelGen ( )  =
		let
			fun counter (initvalue) =
				let val cnt = ref initvalue
				in fn () => (cnt := !cnt + 1; !cnt)
				end
		in
			 let val inc = counter (1336) (* all labels under 1000 are reserved for support code *)
			 in fn (label : string) => label ^ "_" ^ Int.toString (inc ())
			 end
		end;
	val labelgen = SetlabelGen();

	fun generateLoop(name, counter, init, condition, step, body) =
		let
			val loopStart = labelgen(name ^ "_loop_start")
			val loopEnd = labelgen(name ^ "_loop_end")
		in
			makeInstructionSequence(
				[
					Comment(name),
					InstructionWithComment(Assign(counter, MachineConstant ("(void*)(" ^ generateCodeMachineValue(init) ^ ")")), "loop counter"),
					LabelOnly loopStart,
					Free("if (!(" ^ condition ^ ")) goto " ^ generateCodeLabel(loopEnd) ^ " ;")
				] @
				body @
				[
					InstructionWithComment(step, "step"),
					Jump loopStart,
					LabelOnly loopEnd
				]
			)
		end

	(*
		cgs handles multiple expressions and prints the result for each expression.
		this will remain until debugging ends, since production code (aka what we'll submit)
		should only print the last one.
	*)
	fun cgs (expressions) =
		let
			val printStatement = CallCProc("POSTPROCESS", [MachineRegister ResultReg])
			fun cgPrepare (exp) =
				let val originalScheme = unparse(exp)
					val exitLabel = labelgen ("exit")
					val pushdummy = makeOneInstruction(CallCProc("pushDummyFrame", [MachineConstant ("&&"^exitLabel)]))
					val functionEnter = makeOneInstruction(CallCProc ("FUNCTION_ENTER", [MachineConstant(makeCString("\t********** NEW SCHEME COMMAND: "^ originalScheme ^" **********"))]))
					val functionExit = makeOneInstruction(CallCProc ("FUNCTION_EXIT", [MachineConstant(makeCString("\t********** END OF SCHEME COMMAND **********"))]))
				in
					pushdummy ^ functionEnter ^ cg(exp) ^functionExit^ exitLabel^":\n"
				end
		in String.concatWith (makeOneInstruction(printStatement)) (map cgPrepare expressions)
		end

	and wrapCCode(name, exp, result) =
		let val originalScheme = (name ^ ": " ^ unparse(exp))
		in makeConstructComment("start", originalScheme) ^ result ^ makeConstructComment("end", originalScheme)
		end

(********************** TREEWALK **********************)
	and	cg(e as Seq (exps)) = wrapCCode("sequence", e, cgSeq(exps))
	|	cg(e as If (e1,e2,e3)) = wrapCCode("if", e, cgIf (e1,e2,e3))
	|	cg(e as Or (exps)) = wrapCCode("or", e, cgOr(exps))
	|	cg(e as Set (e1,e2)) = wrapCCode("set", e, cgSet (e1,e2))
	|	cg(e as Def (e1,e2)) = wrapCCode("def", e, cgDef (e1,e2))
	|	cg(e as App (func,args)) = wrapCCode("application", e, cgApp(func, args))
	|	cg(e as AppTP (func,args)) = wrapCCode("app tp", e, cgAppTP(func, args))
	(*|	cg(e as AppTP (func,args)) = cg(App(func, args))*)
	|	cg(e as Abs (arglist,exps)) = wrapCCode("lambda", e, cgLambda(arglist,exps))
	|	cg(e as AbsOpt (args, argOpt, body)) = wrapCCode("lambda opt", e, cgLambdaOpt(args, argOpt, body))
	|	cg(e as VarFree (x)) = wrapCCode("var free", e, cgVarFree(x))
	|	cg(e as VarBound (x)) = wrapCCode("var bound", e, cgVarBound (x))
	|	cg(e as VarParam (x)) = wrapCCode("var param", e, cgVarParam(x))
	|	cg(e as Const (exp)) = cgConst(exp)
	(* debugging START *)
	|	cg(e as Var (_)) = raise ErrorBadExpressionType(e)
	|	cg(e as AbsVar (_, _)) = raise ErrorBadExpressionType(e)
	(* debugging END *)
	(* |	cg(expr) = raise unsupportedYET *)

	and cgConst(s as Vector sexprs) = cgConstVector(sexprs)
	|	cgConst(s as Char value) = cgConstChar(value)
	|	cgConst(s as Void) = cgConstVoid()
	|	cgConst(s as Nil) = cgConstNil()
	|	cgConst(s as Symbol name) = wrapCCode("symbol", Const s, cgConstSymbol(name))
	|	cgConst(s as String value) =  cgConstString (value)
	|	cgConst(s as Number value) = cgConstNum (value)
	|	cgConst(s as Bool value) = cgConstBool (value)
	|	cgConst(s as Pair (car, cdr)) = wrapCCode("pair", Const s, cgConstPair(car, cdr))

(********************** SPECIFIC CODE GEN - CONSTS **********************)

	and	cgConstBool (true) = "\tmachine.reg[RES] = makeSchemeBool(TRUE);\n"
	|	cgConstBool (false) = "\tmachine.reg[RES] = makeSchemeBool(FALSE);\n"

	and	cgConstNum (value) =
		let
			val sign = if value>=0 then "" else "-" (* Int.toString(~1) == "~1" and not "-1" *)
		in
			makeInstructionSequence[
				CallCGetter(ResultReg, "makeSchemeInt", MachineConstant (sign ^ Int.toString(Int.abs(value)))),
				TraceResult
			]
		end

	and	cgConstString (value) = makeOneInstruction(CallCGetter(ResultReg, "makeSchemeString", MachineConstant (makeCString(value))))
	and	cgConstVoid() = makeOneInstruction(Assign (ResultReg, MachineConstant "schemeVoid"))
	and	cgConstNil() = makeOneInstruction(Assign (ResultReg, MachineConstant "schemeNil"))
	and	cgConstSymbol(name) = makeOneInstruction(CallCGetter (ResultReg, "makeSchemeSymbol", MachineConstant ("\"" ^ name ^ "\"")))
	and cgConstChar(value) = makeOneInstruction(CallCGetter (ResultReg, "makeSchemeChar", MachineConstant ("'" ^ Char.toCString(value) ^ "'")))

	and	cgConstPair(car, cdr) =
		let
			val tempReg = Reg 0
		in
			cgConst(car) ^
			makeInstructionSequence([
				BackupReg tempReg,
				Assign (tempReg, MachineRegister ResultReg)
			]) ^
			cgConst(cdr) ^
			makeInstructionSequence([
				CallCFunc (ResultReg, "makeSchemePair", [MachineRegister tempReg, MachineRegister ResultReg]),
				RestoreReg tempReg
			])
		end

(********************** SPECIFIC CODE GEN - SPECIAL FORMS **********************)

	and	cgVarFree (name) =
			makeInstructionSequence[
				CallCGetter (ResultReg, "getSymbol", MachineConstant ("\"" ^ name ^ "\"")),
				AssertInstruction ("RUNTIME", "SYMBOL_ENTRY(" ^ generateCodeRegister(ResultReg) ^ ")->isDefined"),
				CallCGetter (ResultReg, "SYMBOL_ENTRY_OBJ", MachineRegister ResultReg),
				TraceResult
			]

	and cgVarParam (name,loc) =
			makeInstructionSequence[
				Assign (ResultReg, MachineConstant ("STACK_ARGV("^Int.toString loc^")")),
				TraceResult
			]

	and cgVarBound (name,major,minor) =
		let val majorStr = Int.toString major
			val minorStr = Int.toString minor
		in
			makeInstructionSequence[
				Assign(ResultReg,MachineConstant("getBoundVar (STACK_ENV(), " ^ majorStr ^", "^ minorStr ^")")),
				TraceResult
			]
		end

	and cgSeq(exps) = (concatenate ((fn (x) => makeOneInstruction(Comment("start new begin statement")) ^ x) o cg) exps) ^ makeOneInstruction(TraceResult)

	and cgOr(exps) =
		let
			val orEnd = labelgen("or_end")
			val generatedExps = map cg exps
		in
			let
				val intermediateCheck = makeOneInstruction(InstructionWithComment(
						CondJump (MachineRegister ResultReg, true, orEnd),
						"end the 'or' if true"
					))
			in
				(String.concatWith intermediateCheck generatedExps) ^
				makeInstructionSequence[
					LabelOnly orEnd,
					TraceResult
				]
			end
		end

	and cgLambdaOpt(args, argOpt, body) =
		let
			val mandatoryArgs = length(args)
			val mandatoryArgsStr = Int.toString(mandatoryArgs)
			val funcName = unparse(AbsOpt (args, argOpt, body))
			val machineFuncName = MachineConstant (makeCString(funcName))
			val lblClosureCode = labelgen ("Closure_Code")
			val lblContinue = labelgen ("Continue")
			val extendedEnvReg = Reg 0
			val localEnvReg = Reg 1
			val tempOptArgListReg = Reg 0
			val amountOfOptionalArgsReg = Reg 1
			val counterReg = Reg 2
			val frameSizeReg = Reg 3
			val makeLocalEnv = CallCFunc (localEnvReg,"makeLocalEnv", [MachineConstant "STACK_ARGS()", MachineConstant "STACK_ARGC()"])
			val makeExtendedEnv = CallCFunc (extendedEnvReg, "extendEnv", [MachineConstant "(Environment)STACK_ENV()", MachineRegister localEnvReg])
			val createClosure = CallCFunc (ResultReg, "makeSchemeClosure", [MachineRegister extendedEnvReg, MachineConstant ("&&" ^ generateCodeLabel(lblClosureCode))])
			val closureCreationCode = makeInstructionSequence[makeLocalEnv, makeExtendedEnv, createClosure]
			val argumentFixup =
				let
					val backupFrameValues = makeInstructionSequence[
							Comment("backups since shifting the frame changes argc"),
							Assign(amountOfOptionalArgsReg, MachineConstant "(void*)STACK_ARGC()"),
							InstructionWithComment(
								Assign(
									amountOfOptionalArgsReg,
									MachineConstant ("(void*)((Amount)" ^ generateCodeRegister(amountOfOptionalArgsReg) ^ " - " ^ mandatoryArgsStr ^ ")")
								),
								"amount of optional args"
							),
							Assign(frameSizeReg, MachineConstant "(void*)(STACK_FRAME_SIZE()+4)")
						]
					fun convertOptArgsToSchemeList(tempReg) =
						makeOneInstruction(CallCFunc(
							tempReg,
							"stackToSchemeList",
							[
								MachineConstant ("STACK_ARGS()-" ^ mandatoryArgsStr),
								MachineConstant ("(Amount)" ^ generateCodeRegister(amountOfOptionalArgsReg))
							]
						))
					(* this is going to be VERY disgusting *)
					val frameFixupEndLabel = labelgen("after_frame_shift")
					val shiftFrameUp =
						generateLoop(
							"shift_frame_up",
							counterReg,
							MachineRegister Sp,
							"(Amount)" ^ generateCodeRegister(counterReg) ^ " >= " ^ generateCodeRegister(Sp) ^
									"-(Amount)" ^ generateCodeRegister(frameSizeReg) ^ "+1",
							Assign(counterReg, MachineConstant("(void*)((Amount)" ^ generateCodeRegister(counterReg) ^ " - 1)")),
							[Free ("machine.stack[(Amount)" ^ generateCodeRegister(counterReg) ^ "] = machine.stack[(Amount)" ^
									generateCodeRegister(counterReg) ^ "-1] ;")]
						) ^
						makeInstructionSequence[
							AssignPlus(Fp, MachineConstant "1"),
							Jump frameFixupEndLabel
						]
					val frameFixup =
							shiftFrameUp ^
							makeInstructionSequence[
								LabelOnly frameFixupEndLabel,
								Assign(Sp, MachineConstant(generateCodeRegister(Fp) ^ "+4")) (* 4 registers were backed up *)
							]
				in
					makeInstructionSequence[
						BackupReg tempOptArgListReg,
						BackupReg amountOfOptionalArgsReg,
						BackupReg counterReg,
						BackupReg frameSizeReg
 					] ^
					backupFrameValues ^
					convertOptArgsToSchemeList(tempOptArgListReg) ^
					frameFixup ^
					makeInstructionSequence[
						InstructionWithComment(AssignFree("machine.stack[machine.fp-4]", "machine.stack[machine.fp-4]+1"),
							"fix ARGC, basically, STACK_ARGC() -= ..."),
						InstructionWithComment(AssignFree("*(STACK_ARGS()-" ^ mandatoryArgsStr ^ ")",
								generateCodeRegister tempOptArgListReg), "fix last argument"),
						RestoreReg frameSizeReg,
						RestoreReg counterReg,
						RestoreReg amountOfOptionalArgsReg,
						RestoreReg tempOptArgListReg
 					]
				end
			val lambdaBody =
					makeInstructionSequence[
						CallCProc("FUNCTION_ENTER", [machineFuncName]),
						AssertInstruction("RUNTIME", "STACK_ARGC() >= " ^ mandatoryArgsStr)
					] ^
					argumentFixup ^
					cg(body) ^
					makeOneInstruction(CallCProc("FUNCTION_EXIT", [machineFuncName]))
		in
			makeInstructionSequence[
				Push(MachineRegister localEnvReg),
				Push(MachineRegister extendedEnvReg)
			] ^
			closureCreationCode ^
			makeInstructionSequence[
				Jump(lblContinue),
				LabelOnly(lblClosureCode)
 			] ^
 			lambdaBody ^
			makeInstructionSequence[
 				LabelOnly(lblContinue),
				Pop(extendedEnvReg),
				Pop(localEnvReg)
			]
		end

	and cgLambda(arglist,exps) =
		let
			val lambdaBody =
				let
					val funcName = unparse(Abs(arglist, exps))
				in
					"\tFUNCTION_ENTER("^makeCString(funcName)^");\n" ^
					makeOneInstruction(AssertInstruction("RUNTIME", "STACK_ARGC() == " ^ Int.toString(length(arglist)))) ^
					cg (exps) ^
					"\tFUNCTION_EXIT ("^makeCString(funcName)^");\n"
				end
			val pushRegs = makeInstructionSequence [Push(MachineRegister (Reg 1)),(*LocalEnv loc*)
													Push(MachineRegister (Reg 2))](*Environment ext*)
			val popRegs = makeInstructionSequence [Pop((Reg 2)),Pop((Reg 1))]
			val lblClosureCode = labelgen ("Closure_Code")
			val lblContinue = labelgen ("Continue")
			val argc = makeOneInstruction (Assign (Reg 0, MachineConstant("STACK_ARGC()")))
			val makeLocalEnv =
					makeInstructionSequence[
						(*Comment ("If there's no args, STACK_ARGC()-1 == -1 which will refer to argc itself and the value 0 (=NULL )will be put"),*)
						Assign (Reg 1,MachineConstant("makeLocalEnv (STACK_ARGS(), STACK_ARGC())"))
					] (*If there's no args, argc will be put which is 0*)
			val extendEnv = makeOneInstruction(Assign (Reg 2,MachineConstant("extendEnv ((Environment)STACK_ENV(), machine.reg[1])")))
			val createClosure = makeOneInstruction(Assign (ResultReg,MachineConstant("makeSchemeClosure (machine.reg[2], &&"^ lblClosureCode ^" )")))
		in
			pushRegs ^ makeLocalEnv ^ extendEnv ^ createClosure ^ popRegs ^
			"\tgoto " ^ lblContinue ^ ";\n\t" ^
			lblClosureCode ^ ":\n" ^
			lambdaBody ^
			"\t" ^ lblContinue ^ ":\n"
		end



	and	cgIf (e1,e2,e3) =
		let
			val cond = cg(e1)
			val res = cg(e2)
			val alt = cg (e3)
			val lblElse = labelgen ("If_Else")
			val lblFinish = labelgen ("If_Done")
		in
			"\n" ^
			cond ^
			"\tif (sobIsFalse(machine.reg[RES])) goto "^ lblElse ^";\n" ^
			"\tDEBUG_NOTICE(\"branch taken\");\n" ^
			res ^
			"\tgoto "^ lblFinish ^";\n\t" ^
			lblElse ^ ":\n\t" ^
			"DEBUG_NOTICE(\"branch not taken\");\n" ^
			alt ^
			"\t" ^ lblFinish ^ ":\n\n"
		end


	and cgAppTP(f, args) =
		let
			val argc = length(args) (*number of args in the new function *)
			val generatedArgExps = map cg (rev(args)) (* codegen to function arguments*)
			val closureCalc = cg(f) (* get the function closure*)
			val pushResult = if argc >0  then makeInstructionSequence[Push (MachineRegister ResultReg)]
											else ""

			val envReg = Reg 1 (* this register will hold the closure enviorment *)
			val codeReg = Reg 0 (* this register will hold the address where the closure code is *)
			val currFrameRet = Reg 2 (* this register will hold the current frame return address to overwrite*)
			val oldFp = Reg 3

			val backupFp = makeOneInstruction(CallCFunc(oldFp, "(void*)STACK_OLD_FP", []))
			val restoreFp = makeOneInstruction(Assign(Fp, MachineConstant ("(int)" ^ generateCodeRegister(oldFp))))

			val currentFrameReturnAddress = makeInstructionSequence[ (* assign current return address to reg*)
										CallCFunc (currFrameRet, "STACK_RET_ADDRESS", [])]
			val prepareForStackOverwrite = makeInstructionSequence[
							InstructionWithComment(
								AssignMinus(Sp,MachineConstant (Int.toString argc)),
								"Puts Sp the begining of items to copy (function arguments)"),
							InstructionWithComment(
								AssignMinus(Fp,MachineConstant("5+STACK_ARGC()")),
								"Bottom of current frame which is also where the base for our overwritten one (5 == (fp+ret+env+argc)+ argv)")]
			fun overWriteCurrStack (0) = ""
			| overWriteCurrStack (args) =
				let val index = Int.toString(args)
				in overWriteCurrStack (args - 1) ^
				   makeOneInstruction(AssignFree("machine.stack[machine.fp+"^Int.toString(args)^"]","machine.stack[machine.sp+"^Int.toString(args-1)^"]"))
				end
			val fixSPtoTopOfNewFrame = makeOneInstruction(InstructionWithComment(
						Assign(Sp,MachineConstant("machine.fp +"^ Int.toString (argc+1))),
						"sets sp to top of overwritten frame"))(* sets sp to top of overwritten frame*)
		in
			makeOneInstruction(Comment ("Start of Pushing args"))^
			String.concatWith pushResult generatedArgExps ^ pushResult ^(*pushing new args to stack*)
			makeOneInstruction(Comment ("End of Pushing args"))^

			closureCalc ^
			makeInstructionSequence[
				AssertInstruction("RUNTIME", "sobIsClosure(" ^ generateCodeRegister(ResultReg) ^ ")"),
				CallCGetter (envReg, "SOB_CLOSURE_ENV", MachineRegister ResultReg),
				CallCGetter (codeReg, "SOB_CLOSURE_CODE", MachineRegister ResultReg)
			] ^

			(* AppTp part start*)
			backupFp ^
			currentFrameReturnAddress ^
			prepareForStackOverwrite ^
			makeOneInstruction(Comment ("Start of overwriting old frame"))^
			overWriteCurrStack (argc) ^
			makeOneInstruction(Comment ("End of overwriting old frame"))^
			fixSPtoTopOfNewFrame ^
			restoreFp ^
			(* AppTp part end*)

			makeOneInstruction(CallFuncReg (MachineRegister codeReg, argc, MachineRegister envReg, currFrameRet))
		end


	and cgApp(f, args) =
		let
			val argc = length(args)
			val generatedArgExps = map cg (rev(args))
			val pushResult = makeInstructionSequence[Push (MachineRegister ResultReg)]
			val envReg = Reg 1
			val returnAddress = labelgen("ret_from_app")
			val codeReg = Reg 0
			val closureCalc = makeOneInstruction(Comment("calculating the closure")) ^ cg(f)
		in
			makeInstructionSequence[
				InstructionWithComment(BackupReg envReg, "will be environment"),
				InstructionWithComment(BackupReg codeReg, "will be code"),
				Comment("calculating application's arguments")
			] ^
			concatenate (fn(x) => x ^ pushResult) generatedArgExps ^
			closureCalc ^
			makeInstructionSequence[
				AssertInstruction("RUNTIME", "sobIsClosure(" ^ generateCodeRegister(ResultReg) ^ ")"),
				CallCGetter (envReg, "SOB_CLOSURE_ENV", MachineRegister ResultReg),
				CallCGetter (codeReg, "SOB_CLOSURE_CODE", MachineRegister ResultReg),
				CallFunc (MachineRegister codeReg, argc, MachineRegister envReg, returnAddress),
				LabelOnly (returnAddress),
				InstructionWithComment(RestoreReg codeReg, "was code"),
				InstructionWithComment(RestoreReg envReg, "was environment"),
				TraceResult
			]
		end

	and cgSet(VarFree(name), e) =
			cg(e) ^
			makeInstructionSequence[
				Push (MachineRegister (Reg 0)),
				CallCFunc (Reg 0,"getSymbol",[MachineConstant (makeCString(name))]),
				AssertInstruction ("RUNTIME", "SYMBOL_ENTRY(" ^ generateCodeRegister(Reg 0) ^ ")->isDefined"),
				AssignFree ("SYMBOL_ENTRY_OBJ(" ^ generateCodeRegister(Reg 0) ^ ")",generateCodeRegister (ResultReg)),
				Pop (Reg 0),
				CallCFunc (ResultReg, "makeSchemeVoid" ,[MachineConstant ("")])
			]
	|	cgSet(VarBound(_, major, minor), e) =
			cg(e) ^
			makeInstructionSequence[
				CallCProc(
					"setBoundVar",
					[
						MachineConstant "STACK_ENV()",
						MachineConstant (Int.toString(major)),
						MachineConstant (Int.toString(minor)),
						MachineRegister ResultReg
					]
				),
				CallCFunc (ResultReg, "makeSchemeVoid" ,[MachineConstant ("")])
			]
	|	cgSet(VarParam(_, minor), e) =
			cg(e) ^
			makeInstructionSequence[
				AssignFree("*(STACK_ARGS()-" ^ Int.toString(minor) ^ ")", generateCodeRegister (ResultReg)),
				CallCFunc (ResultReg, "makeSchemeVoid" ,[MachineConstant ("")])
			]
	|	cgSet(v, _) = raise ErrorBadExpressionType(v)

	and cgConstVector(sexpr)=
		let
			val calcargs = map (fn (se) => (Const(se))) sexpr
			val len =length(calcargs)
			fun putInVec([],_)= ""
				|putInVec(carArg::vecArgs,n)= cg(carArg)^
								makeOneInstruction(CallCProc ("SOB_VECTOR_SET",[MachineRegister(Reg 0) ,MachineConstant(Int.toString(n)), MachineRegister (ResultReg)]))^
								putInVec(vecArgs,n+1)
		in

			makeInstructionSequence[
			Push (MachineRegister (Reg 0)),
			CallCFunc (Reg 0, "makeSchemeVector" ,[MachineConstant( Int.toString(len)), MachineConstant("NULL")])]^
			putInVec(calcargs,0	)^
			makeInstructionSequence[(Assign(ResultReg , MachineRegister(Reg 0))),
				Pop (Reg 0)]
		end


	and cgDef(VarFree (e1),e2)=
		let
			val body = cg(e2)
		in
			body ^
			makeInstructionSequence[
				Push (MachineRegister (Reg 0)),
				Assign (Reg 0,MachineRegister (ResultReg)),
				Push (MachineRegister (Reg 1)),
				CallCFunc (Reg 1,"getSymbol",[MachineConstant (makeCString(e1))]),
				AssignFree ("SYMBOL_ENTRY_OBJ(" ^ generateCodeRegister(Reg 1) ^ ")",generateCodeRegister (Reg 0)),
				AssignFree ("SYMBOL_ENTRY(" ^ generateCodeRegister(Reg 1) ^ ")->isDefined", "TRUE"),
				CallCFunc (ResultReg, "makeSchemeVoid" ,[MachineConstant ("")]),
				Pop (Reg 1),
				Pop (Reg 0)
			]
		end
	|	cgDef(e, _) = raise ErrorBadExpressionType(e)


	fun	compileSchemeFile (inputfile,outputfile) =
		let
			val str = fileToString (inputfile)
			val stringToAsts = (map SemanticAnalysis.semanticAnalysis) o TagParser.stringToPEs
			val fileHeader =
				"#include <base.h>\n" ^
				"#include <debug.h>\n" ^
				"#include \"scheme.h\"\n" ^
				"\n" ^
				"void schemeCompiledFunction(void)\n" ^
				"{\n" ^
				generateDebug("ENTER", "", []) ^
				"\n" ^
				generateCodeInstruction(Comment "this is nasty, but so is using gcc's extension. i am disgusted to write this.") ^ "\n" ^
				"#include \"runtime.c\"\n" ^
				"#include \"supportcode.c\"\n" ^
				"\n"
			val	fileFooter =
				"\n" ^
				generateDebug("EXIT", "", []) ^
				"\treturn ;\n" ^
				"}\n" ^
				"\n"
		in
			stringToFile(outputfile, fileHeader ^ cgs(stringToAsts str) ^ fileFooter)
		end;
end;
